home *** CD-ROM | disk | FTP | other *** search
/ Shareware Super Platinum 8 / Shareware Super Platinum 8.iso / mac / DATABASE / DW4.ZIP;1 / DW4.FXP (.txt) next >
Encoding:
MS Visual FoxPro App  |  1994-05-26  |  9.8 KB  |  228 lines
  1. cDBFSf
  2. cDBFS
  3. 2.0Fl
  4. AMERICAN
  5. MODIFY WINDOW SCREEN TITLE "Foxpro for Macintosh" &cFONTS
  6. MODIFY WINDOW SCREEN TITLE "Foxpro for Windows" &cFONTS
  7. DEBUG7@
  8. RUNTIMEFFlj
  9. EXEFFlj
  10. SUSPEND
  11. Data Wire Four 01.02.03
  12. (c) 1993 Dennis Allen
  13. All rights reserved
  14. PROCEDURE 
  15. PARAMETERS cPATH, bBACK
  16. SAVE SCREEN
  17. CLEAR
  18. ? "*"
  19. ? "* Data Wire Four 01.02.03"
  20. ? "* (c) 1993 Dennis Allen"
  21. ? "* All rights reserved"
  22. ? "*"
  23. ? "Please Wait..."
  24. PRIVATE FLD, FLD1, FLD2, bFLAG, cDRIV_SEP, cERROR, cEXACT, cFILE, cPATH_SEP, nCOL, nROW
  25. IF "2.0" $ VERSION()
  26.   STORE .F. TO _MAC, _UNIX, _WINDOWS
  27.   STORE .T. TO _DOS
  28. ENDIF
  29. IF TYPE("cPATH") = "C"
  30.   PRIVATE cDATAPATH
  31.   cDATAPATH = cPATH
  32. ENDIF
  33. cPATH_SEP = "\"
  34. cDRIV_SEP = ":\"
  35. cDATAPATH = FULLPATH(IIF(TYPE("cDATAPATH")<>"C","",ALLTRIM(cDATAPATH)))
  36. IF LEN(cDATAPATH) > 0 .AND. .NOT. RIGHT(cDATAPATH,1) $ cDRIV_SEP
  37.   cDATAPATH=cDATAPATH+cPATH_SEP
  38. ENDIF
  39. IF      ADIR(FLD,ALLTRIM(cDATAPATH)+"*.","D") = 0 ;
  40.   .AND. ADIR(FLD,FULLPATH("")+"*.","D") > 0
  41.   ? "File Path "+cDATAPATH+" does not exist"
  42.   WAIT WINDOW
  43.   IF SYS(16,1) = SYS(16)
  44.     QUIT
  45.   ENDIF
  46.   RETURN
  47. ENDIF
  48. bBACK = IIF(PARAMETERS()>1.AND.TYPE("bBACK")="L",bBACK,.T.)
  49. cFILE = SYS(3)
  50. DO WHILE cFILE = SYS(3)
  51. ENDDO
  52. cERROR = ON("ERROR")
  53. ON ERROR
  54. cEXACT = SET("EXACT")
  55. SET EXACT ON
  56. CLOSE DATABASES
  57. *.DBFa
  58. FOXUSER
  59. *.DBF
  60. SCR.DBF
  61. *.DBF
  62. *.DBF
  63. DO FF
  64. CLOSE DATABASES
  65. ON ERROR 
  66. cERROR
  67. SET EXACT 
  68. cEXACT
  69. ? "Verification Complete..."
  70. IF SYS(16,1) = SYS(16)
  71.   WAIT WINDOW
  72.   QUIT
  73. ENDIF
  74. RESTORE SCREEN
  75. RETURN
  76. PROCEDURE FF
  77. ? "Verifying 
  78. RELEASE FLD1, FLD2
  79. DIMENSION FLD1(
  80. ,4), FLD2(1,4)
  81. mFLDf
  82. FLD1(
  83. STORE .F. TO bFLAG
  84. IF !SYS(2000,cDATAPATH+"
  85. ") == ""
  86.   USE (cDATAPATH+"
  87. ") ALIAS TEMP
  88.   = AFIELDS(FLD2)
  89. ENDIF
  90. bFLAG = ADJUST(@FLD1, @FLD2)
  91. IF bFLAG
  92.   ? " Updating "+cDATAPATH+"
  93.   USE
  94.   CREATE TABLE (cDATAPATH+cFILE) FROM ARRAY FLD1
  95.   IF !SYS(2000,cDATAPATH+"
  96. ") == ""
  97.     APPEND FROM (cDATAPATH+"
  98.     IF bBACK
  99.       DELETE FILE (cDATAPATH+"
  100.       RENAME (cDATAPATH+"
  101. ") TO (cDATAPATH+"
  102.     ENDIF
  103.     DELETE FILE (cDATAPATH+"
  104.   ENDIF
  105.   IF !SYS(2000,cDATAPATH+"
  106. ") == ""
  107.     IF bBACK
  108.       DELETE FILE (cDATAPATH+"
  109.       RENAME (cDATAPATH+"
  110. ") TO (cDATAPATH+"
  111.     ENDIF
  112.     DELETE FILE (cDATAPATH+"
  113.   ENDIF
  114.   DELETE FILE (cDATAPATH+"
  115.   DELETE FILE (cDATAPATH+"
  116.   DELETE FILE (cDATAPATH+"
  117.   USE
  118.   IF !SYS(2000,cDATAPATH+cFILE+".DBF") == ""
  119.     RENAME (cDATAPATH+cFILE+".DBF") TO (cDATAPATH+"
  120.   ENDIF
  121.   IF !SYS(2000,cDATAPATH+cFILE+".FPT") == ""
  122.     RENAME (cDATAPATH+cFILE+".FPT") TO (cDATAPATH+"
  123.   ENDIF
  124. ENDIF
  125. RELEASE FLD
  126. DIMENSION FLD(
  127. mFLDf
  128. IF .NOT. USED("TEMP") .AND. !SYS(2000,cDATAPATH+"
  129. ") == ""
  130.   USE (cDATAPATH+"
  131. ") ALIAS TEMP
  132. ENDIF
  133. STORE .F. TO bFLAG
  134. FOR nROW = 1 TO 
  135.   IF FLD(nROW,1) <> TAG(nROW) .OR. FLD(nROW,2) <> KEY(nROW) .OR. FLD(nROW,3) <> SYS(2021,nROW)
  136.     STORE .T. TO bFLAG
  137.     EXIT
  138.   ENDIF
  139. ENDFOR
  140. IF bFLAG
  141.   ? " Updating "+cDATAPATH+"
  142.   USE (cDATAPATH+"
  143. ") ALIAS TEMP EXCLUSIVE
  144.   DELETE TAG ALL
  145. INDEX ON F
  146.  TAG 
  147.  FOR F
  148. ENDIF
  149. RETURN
  150. FUNCTION ADJUST
  151. PARAMETERS FLD1, FLD2
  152. IF TYPE("FLD2") = "L"
  153.   DIMENSION FLD2(ALEN(FLD1,1),ALEN(FLD1,2))
  154.   = ACOPY(FLD1,FLD2)
  155.   RETURN .T.
  156. ENDIF
  157. PRIVATE bFLAG, nCOL, nDIF, nROW, nROW1, nROW2
  158. FOR nROW = 1 TO ALEN(FLD2,1)
  159.   FLD2(nROW,1) = PADR(FLD2(nROW,1),10)
  160.   nROW1 = ASCAN(FLD1,FLD2(nROW,1))
  161.   nROW1 = IIF(nROW1 <> 0, ASUBSCRIPT(FLD1,nROW1,1),0)
  162.   IF nROW1 = 0
  163.     nROW1 = ALEN(FLD1,1)+1
  164.     DIMENSION FLD1(nROW1,4)
  165.     FOR nCOL = 1 TO 4
  166.       FLD1(nROW1,nCOL) = FLD2(nROW,nCOL)
  167.     ENDFOR
  168.   ENDIF
  169.   IF FLD1(nROW1,2) <> FLD2(nROW,2)
  170.     ? "Warning: "+FLD2(nROW,1)+" has a field type ("+FLD2(nROW,2)+")"
  171.     ? "                  "    +" needs field type ("+FLD1(nROW1,2)+")"
  172.     WAIT WINDOW
  173.     FLD1(nROW1,2) = FLD2(nROW,2)
  174.   ENDIF
  175.   IF FLD1(nROW1,4) < FLD2(nROW,4)
  176.     FLD1(nROW1,4) = FLD2(nROW,4)
  177.   ENDIF
  178.   nDIF = (FLD2(nROW,3) - FLD2(nROW,4)) - (FLD1(nROW1,3) - FLD1(nROW1,4))
  179.   IF nDIF > 0
  180.     FLD1(nROW1,3) = FLD1(nROW1,3) + nDIF
  181.   ENDIF
  182. ENDFOR
  183. STORE .F. TO bFLAG
  184. FOR nROW = 1 TO ALEN(FLD1,1)
  185.   nROW2 = ASCAN(FLD2,FLD1(nROW,1))
  186.   nROW2 = IIF(nROW2 <> 0, ASUBSCRIPT(FLD2,nROW2,1),0)
  187.   IF nROW2 = 0
  188.     STORE .T. TO bFLAG
  189.     EXIT
  190.   ENDIF
  191.   IF FLD2(nROW2,4) < FLD1(nROW,4)
  192.     STORE .T. TO bFLAG
  193.     EXIT
  194.   ENDIF
  195.   nDIF = (FLD1(nROW,3) - FLD1(nROW,4)) - (FLD2(nROW2,3) - FLD2(nROW2,4))
  196.   IF nDIF > 0
  197.     STORE .T. TO bFLAG
  198.     EXIT
  199.   ENDIF
  200. ENDFOR
  201. RETURN bFLAG
  202. *.FXPa
  203. command
  204. CDBFS
  205.    DAMERICAN
  206.  NTMP
  207.    CTEMP
  208. _BROTMP
  209. O FLNTEMP
  210.     CTEMP2
  211. CTEMP3
  212. FLDCTEMP3I
  213.  DCTEMP3N
  214. CTEMP4
  215. TYPCTEMP5
  216.    TEMP
  217. O FLDCROW
  218.     DNROW
  219.  OPT_CCOL
  220.    DOMFLD
  221.  CFLD
  222.  NFLD
  223. ENFLD
  224. ECCOUCTAG
  225. D:\DW4\
  226. DW4.FXP
  227. D:\DW4\DW4.PRG
  228.